home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / language / harvest.cpt / Harvest C / Tcl 6.2 / tclHash.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-04-12  |  24.5 KB  |  936 lines

  1. #ifdef macintosh
  2. #    pragma segment tclHash
  3. #endif
  4.  
  5. /* 
  6.  * tclHash.c --
  7.  *
  8.  *    Implementation of in-memory hash tables for Tcl and Tcl-based
  9.  *    applications.
  10.  *
  11.  * Copyright 1991 Regents of the University of California
  12.  * Permission to use, copy, modify, and distribute this
  13.  * software and its documentation for any purpose and without
  14.  * fee is hereby granted, provided that this copyright
  15.  * notice appears in all copies.  The University of California
  16.  * makes no representations about the suitability of this
  17.  * software for any purpose.  It is provided "as is" without
  18.  * express or implied warranty.
  19.  */
  20.  
  21. #ifndef lint
  22. static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclHash.c,v 1.9 92/01/04 15:45:21 ouster Exp $ SPRITE (Berkeley)";
  23. #endif /* not lint */
  24.  
  25. #include "tclInt.h"
  26.  
  27. /*
  28.  * Imported library procedures for which there are no header files:
  29.  */
  30.  
  31. extern void panic();
  32.  
  33. /*
  34.  * When there are this many entries per bucket, on average, rebuild
  35.  * the hash table to make it larger.
  36.  */
  37.  
  38. #define REBUILD_MULTIPLIER    3
  39.  
  40.  
  41. /*
  42.  * The following macro takes a preliminary integer hash value and
  43.  * produces an index into a hash tables bucket list.  The idea is
  44.  * to make it so that preliminary values that are arbitrarily similar
  45.  * will end up in different buckets.  The hash function was taken
  46.  * from a random-number generator.
  47.  */
  48.  
  49. #define RANDOM_INDEX(tablePtr, i) \
  50.     (((((long) (i))*1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask)
  51.  
  52. /*
  53.  * Procedure prototypes for static procedures in this file:
  54.  */
  55.  
  56. static Tcl_HashEntry *    ArrayFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  57.                 char *key));
  58. static Tcl_HashEntry *    ArrayCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  59.                 char *key, int *newPtr));
  60. static Tcl_HashEntry *    BogusFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  61.                 char *key));
  62. static Tcl_HashEntry *    BogusCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  63.                 char *key, int *newPtr));
  64. static int        HashString _ANSI_ARGS_((char *string));
  65. static void        RebuildTable _ANSI_ARGS_((Tcl_HashTable *tablePtr));
  66. static Tcl_HashEntry *    StringFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  67.                 char *key));
  68. static Tcl_HashEntry *    StringCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  69.                 char *key, int *newPtr));
  70. static Tcl_HashEntry *    OneWordFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  71.                 char *key));
  72. static Tcl_HashEntry *    OneWordCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  73.                 char *key, int *newPtr));
  74.  
  75. /*
  76.  *----------------------------------------------------------------------
  77.  *
  78.  * Tcl_InitHashTable --
  79.  *
  80.  *    Given storage for a hash table, set up the fields to prepare
  81.  *    the hash table for use.
  82.  *
  83.  * Results:
  84.  *    None.
  85.  *
  86.  * Side effects:
  87.  *    TablePtr is now ready to be passed to Tcl_FindHashEntry and
  88.  *    Tcl_CreateHashEntry.
  89.  *
  90.  *----------------------------------------------------------------------
  91.  */
  92.  
  93. void
  94. Tcl_InitHashTable(tablePtr, keyType)
  95.     register Tcl_HashTable *tablePtr;    /* Pointer to table record, which
  96.                      * is supplied by the caller. */
  97.     int keyType;            /* Type of keys to use in table:
  98.                      * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
  99.                      * or an integer >= 2. */
  100. {
  101.     tablePtr->buckets = tablePtr->staticBuckets;
  102.     tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;
  103.     tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
  104.     tablePtr->numBuckets = TCL_SMALL_HASH_TABLE;
  105.     tablePtr->numEntries = 0;
  106.     tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER;
  107.     tablePtr->downShift = 28;
  108.     tablePtr->mask = 3;
  109.     tablePtr->keyType = keyType;
  110.     if (keyType == TCL_STRING_KEYS) {
  111.     tablePtr->findProc = StringFind;
  112.     tablePtr->createProc = StringCreate;
  113.     } else if (keyType == TCL_ONE_WORD_KEYS) {
  114.     tablePtr->findProc = OneWordFind;
  115.     tablePtr->createProc = OneWordCreate;
  116.     } else {
  117.     tablePtr->findProc = ArrayFind;
  118.     tablePtr->createProc = ArrayCreate;
  119.     };
  120. }
  121.  
  122. /*
  123.  *----------------------------------------------------------------------
  124.  *
  125.  * Tcl_DeleteHashEntry --
  126.  *
  127.  *    Remove a single entry from a hash table.
  128.  *
  129.  * Results:
  130.  *    None.
  131.  *
  132.  * Side effects:
  133.  *    The entry given by entryPtr is deleted from its table and
  134.  *    should never again be used by the caller.  It is up to the
  135.  *    caller to free the clientData field of the entry, if that
  136.  *    is relevant.
  137.  *
  138.  *----------------------------------------------------------------------
  139.  */
  140.  
  141. void
  142. Tcl_DeleteHashEntry(entryPtr)
  143.     Tcl_HashEntry *entryPtr;
  144. {
  145.     register Tcl_HashEntry *prevPtr;
  146.  
  147.     if (*entryPtr->bucketPtr == entryPtr) {
  148.     *entryPtr->bucketPtr = entryPtr->nextPtr;
  149.     } else {
  150.     for (prevPtr = *entryPtr->bucketPtr; ; prevPtr = prevPtr->nextPtr) {
  151.         if (prevPtr == NULL) {
  152.         panic("malformed bucket chain in Tcl_DeleteHashEntry");
  153.         }
  154.         if (prevPtr->nextPtr == entryPtr) {
  155.         prevPtr->nextPtr = entryPtr->nextPtr;
  156.         break;
  157.         }
  158.     }
  159.     }
  160.     entryPtr->tablePtr->numEntries--;
  161.     ckfree((char *) entryPtr);
  162. }
  163.  
  164. /*
  165.  *----------------------------------------------------------------------
  166.  *
  167.  * Tcl_DeleteHashTable --
  168.  *
  169.  *    Free up everything associated with a hash table except for
  170.  *    the record for the table itself.
  171.  *
  172.  * Results:
  173.  *    None.
  174.  *
  175.  * Side effects:
  176.  *    The hash table is no longer useable.
  177.  *
  178.  *----------------------------------------------------------------------
  179.  */
  180.  
  181. void
  182. Tcl_DeleteHashTable(tablePtr)
  183.     register Tcl_HashTable *tablePtr;        /* Table to delete. */
  184. {
  185.     register Tcl_HashEntry *hPtr, *nextPtr;
  186.     int i;
  187.  
  188.     /*
  189.      * Free up all the entries in the table.
  190.      */
  191.  
  192.     for (i = 0; i < tablePtr->numBuckets; i++) {
  193.     hPtr = tablePtr->buckets[i];
  194.     while (hPtr != NULL) {
  195.         nextPtr = hPtr->nextPtr;
  196.         ckfree((char *) hPtr);
  197.         hPtr = nextPtr;
  198.     }
  199.     }
  200.  
  201.     /*
  202.      * Free up the bucket array, if it was dynamically allocated.
  203.      */
  204.  
  205.     if (tablePtr->buckets != tablePtr->staticBuckets) {
  206.     ckfree((char *) tablePtr->buckets);
  207.     }
  208.  
  209.     /*
  210.      * Arrange for panics if the table is used again without
  211.      * re-initialization.
  212.      */
  213.  
  214.     tablePtr->findProc = BogusFind;
  215.     tablePtr->createProc = BogusCreate;
  216. }
  217.  
  218. /*
  219.  *----------------------------------------------------------------------
  220.  *
  221.  * Tcl_FirstHashEntry --
  222.  *
  223.  *    Locate the first entry in a hash table and set up a record
  224.  *    that can be used to step through all the remaining entries
  225.  *    of the table.
  226.  *
  227.  * Results:
  228.  *    The return value is a pointer to the first entry in tablePtr,
  229.  *    or NULL if tablePtr has no entries in it.  The memory at
  230.  *    *searchPtr is initialized so that subsequent calls to
  231.  *    Tcl_NextHashEntry will return all of the entries in the table,
  232.  *    one at a time.
  233.  *
  234.  * Side effects:
  235.  *    None.
  236.  *
  237.  *----------------------------------------------------------------------
  238.  */
  239.  
  240. Tcl_HashEntry *
  241. Tcl_FirstHashEntry(tablePtr, searchPtr)
  242.     Tcl_HashTable *tablePtr;        /* Table to search. */
  243.     Tcl_HashSearch *searchPtr;        /* Place to store information about
  244.                      * progress through the table. */
  245. {
  246.     searchPtr->tablePtr = tablePtr;
  247.     searchPtr->nextIndex = 0;
  248.     searchPtr->nextEntryPtr = NULL;
  249.     return Tcl_NextHashEntry(searchPtr);
  250. }
  251.  
  252. /*
  253.  *----------------------------------------------------------------------
  254.  *
  255.  * Tcl_NextHashEntry --
  256.  *
  257.  *    Once a hash table enumeration has been initiated by calling
  258.  *    Tcl_FirstHashEntry, this procedure may be called to return
  259.  *    successive elements of the table.
  260.  *
  261.  * Results:
  262.  *    The return value is the next entry in the hash table being
  263.  *    enumerated, or NULL if the end of the table is reached.
  264.  *
  265.  * Side effects:
  266.  *    None.
  267.  *
  268.  *----------------------------------------------------------------------
  269.  */
  270.  
  271. Tcl_HashEntry *
  272. Tcl_NextHashEntry(searchPtr)
  273.     register Tcl_HashSearch *searchPtr;    /* Place to store information about
  274.                      * progress through the table.  Must
  275.                      * have been initialized by calling
  276.                      * Tcl_FirstHashEntry. */
  277. {
  278.     Tcl_HashEntry *hPtr;
  279.  
  280.     while (searchPtr->nextEntryPtr == NULL) {
  281.     if (searchPtr->nextIndex >= searchPtr->tablePtr->numBuckets) {
  282.         return NULL;
  283.     }
  284.     searchPtr->nextEntryPtr =
  285.         searchPtr->tablePtr->buckets[searchPtr->nextIndex];
  286.     searchPtr->nextIndex++;
  287.     }
  288.     hPtr = searchPtr->nextEntryPtr;
  289.     searchPtr->nextEntryPtr = hPtr->nextPtr;
  290.     return hPtr;
  291. }
  292.  
  293. /*
  294.  *----------------------------------------------------------------------
  295.  *
  296.  * Tcl_HashStats --
  297.  *
  298.  *    Return statistics describing the layout of the hash table
  299.  *    in its hash buckets.
  300.  *
  301.  * Results:
  302.  *    The return value is a malloc-ed string containing information
  303.  *    about tablePtr.  It is the caller's responsibility to free
  304.  *    this string.
  305.  *
  306.  * Side effects:
  307.  *    None.
  308.  *
  309.  *----------------------------------------------------------------------
  310.  */
  311.  
  312. char *
  313. Tcl_HashStats(tablePtr)
  314.     Tcl_HashTable *tablePtr;        /* Table for which to produce stats. */
  315. {
  316. #define NUM_COUNTERS 10
  317.     int count[NUM_COUNTERS], overflow, i, j;
  318.     double average, tmp;
  319.     register Tcl_HashEntry *hPtr;
  320.     char *result, *p;
  321.  
  322.     /*
  323.      * Compute a histogram of bucket usage.
  324.      */
  325.  
  326.     for (i = 0; i < NUM_COUNTERS; i++) {
  327.     count[i] = 0;
  328.     }
  329.     overflow = 0;
  330.     average = 0.0;
  331.     for (i = 0; i < tablePtr->numBuckets; i++) {
  332.     j = 0;
  333.     for (hPtr = tablePtr->buckets[i]; hPtr != NULL; hPtr = hPtr->nextPtr) {
  334.         j++;
  335.     }
  336.     if (j < NUM_COUNTERS) {
  337.         count[j]++;
  338.     } else {
  339.         overflow++;
  340.     }
  341.     tmp = j;
  342.     average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
  343.     }
  344.  
  345.     /*
  346.      * Print out the histogram and a few other pieces of information.
  347.      */
  348.  
  349.     result = (char *) ckalloc((unsigned) ((NUM_COUNTERS*60) + 300));
  350.     sprintf(result, "%d entries in table, %d buckets\n",
  351.         tablePtr->numEntries, tablePtr->numBuckets);
  352.     p = result + strlen(result);
  353.     for (i = 0; i < NUM_COUNTERS; i++) {
  354.     sprintf(p, "number of buckets with %d entries: %d\n",
  355.         i, count[i]);
  356.     p += strlen(p);
  357.     }
  358.     sprintf(p, "number of buckets with more %d or more entries: %d\n",
  359.         NUM_COUNTERS, overflow);
  360.     p += strlen(p);
  361.     sprintf(p, "average search distance for entry: %.1f", average);
  362.     return result;
  363. }
  364.  
  365. /*
  366.  *----------------------------------------------------------------------
  367.  *
  368.  * HashString --
  369.  *
  370.  *    Compute a one-word summary of a text string, which can be
  371.  *    used to generate a hash index.
  372.  *
  373.  * Results:
  374.  *    The return value is a one-word summary of the information in
  375.  *    string.
  376.  *
  377.  * Side effects:
  378.  *    None.
  379.  *
  380.  *----------------------------------------------------------------------
  381.  */
  382.  
  383. static int
  384. HashString(string)
  385.     register char *string;    /* String from which to compute hash value. */
  386. {
  387.     register int result, c;
  388.  
  389.     /*
  390.      * I tried a zillion different hash functions and asked many other
  391.      * people for advice.  Many people had their own favorite functions,
  392.      * all different, but no-one had much idea why they were good ones.
  393.      * I chose the one below (multiply by 9 and add _new character)
  394.      * because of the following reasons:
  395.      *
  396.      * 1. Multiplying by 10 is perfect for keys that are decimal strings,
  397.      *    and multiplying by 9 is just about as good.
  398.      * 2. Times-9 is (shift-left-3) plus (old).  This means that each
  399.      *    character's bits hang around in the low-order bits of the
  400.      *    hash value for ever, plus they spread fairly rapidly up to
  401.      *    the high-order bits to fill out the hash value.  This seems
  402.      *    works well both for decimal and non-decimal strings.
  403.      */
  404.  
  405.     result = 0;
  406.     while (1) {
  407.     c = *string;
  408.     string++;
  409.     if (c == 0) {
  410.         break;
  411.     }
  412.     result += (result<<3) + c;
  413.     }
  414.     return result;
  415. }
  416.  
  417. /*
  418.  *----------------------------------------------------------------------
  419.  *
  420.  * StringFind --
  421.  *
  422.  *    Given a hash table with string keys, and a string key, find
  423.  *    the entry with a matching key.
  424.  *
  425.  * Results:
  426.  *    The return value is a token for the matching entry in the
  427.  *    hash table, or NULL if there was no matching entry.
  428.  *
  429.  * Side effects:
  430.  *    None.
  431.  *
  432.  *----------------------------------------------------------------------
  433.  */
  434.  
  435. static Tcl_HashEntry *
  436. StringFind(tablePtr, key)
  437.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  438.     char *key;            /* Key to use to find matching entry. */
  439. {
  440.     register Tcl_HashEntry *hPtr;
  441.     register char *p1, *p2;
  442.     int index;
  443.  
  444.     index = HashString(key) & tablePtr->mask;
  445.  
  446.     /*
  447.      * Search all of the entries in the appropriate bucket.
  448.      */
  449.  
  450.     for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
  451.         hPtr = hPtr->nextPtr) {
  452.     for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) {
  453.         if (*p1 != *p2) {
  454.         break;
  455.         }
  456.         if (*p1 == '\0') {
  457.         return hPtr;
  458.         }
  459.     }
  460.     }
  461.     return NULL;
  462. }
  463.  
  464. /*
  465.  *----------------------------------------------------------------------
  466.  *
  467.  * StringCreate --
  468.  *
  469.  *    Given a hash table with string keys, and a string key, find
  470.  *    the entry with a matching key.  If there is no matching entry,
  471.  *    then create a _new entry that does match.
  472.  *
  473.  * Results:
  474.  *    The return value is a pointer to the matching entry.  If this
  475.  *    is a newly-created entry, then *newPtr will be set to a non-zero
  476.  *    value;  otherwise *newPtr will be set to 0.  If this is a _new
  477.  *    entry the value stored in the entry will initially be 0.
  478.  *
  479.  * Side effects:
  480.  *    A _new entry may be added to the hash table.
  481.  *
  482.  *----------------------------------------------------------------------
  483.  */
  484.  
  485. static Tcl_HashEntry *
  486. StringCreate(tablePtr, key, newPtr)
  487.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  488.     char *key;            /* Key to use to find or create matching
  489.                  * entry. */
  490.     int *newPtr;        /* Store info here telling whether a _new
  491.                  * entry was created. */
  492. {
  493.     register Tcl_HashEntry *hPtr;
  494.     register char *p1, *p2;
  495.     int index;
  496.  
  497.     index = HashString(key) & tablePtr->mask;
  498.  
  499.     /*
  500.      * Search all of the entries in this bucket.
  501.      */
  502.  
  503.     for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
  504.         hPtr = hPtr->nextPtr) {
  505.     for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) {
  506.         if (*p1 != *p2) {
  507.         break;
  508.         }
  509.         if (*p1 == '\0') {
  510.         *newPtr = 0;
  511.         return hPtr;
  512.         }
  513.     }
  514.     }
  515.  
  516.     /*
  517.      * Entry not found.  Add a _new one to the bucket.
  518.      */
  519.  
  520.     *newPtr = 1;
  521.     hPtr = (Tcl_HashEntry *) ckalloc((unsigned)
  522.         (sizeof(Tcl_HashEntry) + strlen(key) - (sizeof(hPtr->key) -1)));
  523.     hPtr->tablePtr = tablePtr;
  524.     hPtr->bucketPtr = &(tablePtr->buckets[index]);
  525.     hPtr->nextPtr = *hPtr->bucketPtr;
  526.     hPtr->clientData = 0;
  527.     strcpy(hPtr->key.string, key);
  528.     *hPtr->bucketPtr = hPtr;
  529.     tablePtr->numEntries++;
  530.  
  531.     /*
  532.      * If the table has exceeded a decent size, rebuild it with many
  533.      * more buckets.
  534.      */
  535.  
  536.     if (tablePtr->numEntries >= tablePtr->rebuildSize) {
  537.     RebuildTable(tablePtr);
  538.     }
  539.     return hPtr;
  540. }
  541.  
  542. /*
  543.  *----------------------------------------------------------------------
  544.  *
  545.  * OneWordFind --
  546.  *
  547.  *    Given a hash table with one-word keys, and a one-word key, find
  548.  *    the entry with a matching key.
  549.  *
  550.  * Results:
  551.  *    The return value is a token for the matching entry in the
  552.  *    hash table, or NULL if there was no matching entry.
  553.  *
  554.  * Side effects:
  555.  *    None.
  556.  *
  557.  *----------------------------------------------------------------------
  558.  */
  559.  
  560. static Tcl_HashEntry *
  561. OneWordFind(tablePtr, key)
  562.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  563.     register char *key;        /* Key to use to find matching entry. */
  564. {
  565.     register Tcl_HashEntry *hPtr;
  566.     int index;
  567.  
  568.     index = RANDOM_INDEX(tablePtr, key);
  569.  
  570.     /*
  571.      * Search all of the entries in the appropriate bucket.
  572.      */
  573.  
  574.     for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
  575.         hPtr = hPtr->nextPtr) {
  576.     if (hPtr->key.oneWordValue == key) {
  577.         return hPtr;
  578.     }
  579.     }
  580.     return NULL;
  581. }
  582.  
  583. /*
  584.  *----------------------------------------------------------------------
  585.  *
  586.  * OneWordCreate --
  587.  *
  588.  *    Given a hash table with one-word keys, and a one-word key, find
  589.  *    the entry with a matching key.  If there is no matching entry,
  590.  *    then create a _new entry that does match.
  591.  *
  592.  * Results:
  593.  *    The return value is a pointer to the matching entry.  If this
  594.  *    is a newly-created entry, then *newPtr will be set to a non-zero
  595.  *    value;  otherwise *newPtr will be set to 0.  If this is a _new
  596.  *    entry the value stored in the entry will initially be 0.
  597.  *
  598.  * Side effects:
  599.  *    A _new entry may be added to the hash table.
  600.  *
  601.  *----------------------------------------------------------------------
  602.  */
  603.  
  604. static Tcl_HashEntry *
  605. OneWordCreate(tablePtr, key, newPtr)
  606.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  607.     register char *key;        /* Key to use to find or create matching
  608.                  * entry. */
  609.     int *newPtr;        /* Store info here telling whether a _new
  610.                  * entry was created. */
  611. {
  612.     register Tcl_HashEntry *hPtr;
  613.     int index;
  614.  
  615.     index = RANDOM_INDEX(tablePtr, key);
  616.  
  617.     /*
  618.      * Search all of the entries in this bucket.
  619.      */
  620.  
  621.     for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
  622.         hPtr = hPtr->nextPtr) {
  623.     if (hPtr->key.oneWordValue == key) {
  624.         *newPtr = 0;
  625.         return hPtr;
  626.     }
  627.     }
  628.  
  629.     /*
  630.      * Entry not found.  Add a _new one to the bucket.
  631.      */
  632.  
  633.     *newPtr = 1;
  634.     hPtr = (Tcl_HashEntry *) ckalloc(sizeof(Tcl_HashEntry));
  635.     hPtr->tablePtr = tablePtr;
  636.     hPtr->bucketPtr = &(tablePtr->buckets[index]);
  637.     hPtr->nextPtr = *hPtr->bucketPtr;
  638.     hPtr->clientData = 0;
  639.     hPtr->key.oneWordValue = key;
  640.     *hPtr->bucketPtr = hPtr;
  641.     tablePtr->numEntries++;
  642.  
  643.     /*
  644.      * If the table has exceeded a decent size, rebuild it with many
  645.      * more buckets.
  646.      */
  647.  
  648.     if (tablePtr->numEntries >= tablePtr->rebuildSize) {
  649.     RebuildTable(tablePtr);
  650.     }
  651.     return hPtr;
  652. }
  653.  
  654. /*
  655.  *----------------------------------------------------------------------
  656.  *
  657.  * ArrayFind --
  658.  *
  659.  *    Given a hash table with array-of-int keys, and a key, find
  660.  *    the entry with a matching key.
  661.  *
  662.  * Results:
  663.  *    The return value is a token for the matching entry in the
  664.  *    hash table, or NULL if there was no matching entry.
  665.  *
  666.  * Side effects:
  667.  *    None.
  668.  *
  669.  *----------------------------------------------------------------------
  670.  */
  671.  
  672. static Tcl_HashEntry *
  673. ArrayFind(tablePtr, key)
  674.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  675.     char *key;            /* Key to use to find matching entry. */
  676. {
  677.     register Tcl_HashEntry *hPtr;
  678.     int *arrayPtr = (int *) key;
  679.     register int *iPtr1, *iPtr2;
  680.     int index, count;
  681.  
  682.     for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr;
  683.         count > 0; count--, iPtr1++) {
  684.     index += *iPtr1;
  685.     }
  686.     index = RANDOM_INDEX(tablePtr, index);
  687.  
  688.     /*
  689.      * Search all of the entries in the appropriate bucket.
  690.      */
  691.  
  692.     for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
  693.         hPtr = hPtr->nextPtr) {
  694.     for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words,
  695.         count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
  696.         if (count == 0) {
  697.         return hPtr;
  698.         }
  699.         if (*iPtr1 != *iPtr2) {
  700.         break;
  701.         }
  702.     }
  703.     }
  704.     return NULL;
  705. }
  706.  
  707. /*
  708.  *----------------------------------------------------------------------
  709.  *
  710.  * ArrayCreate --
  711.  *
  712.  *    Given a hash table with one-word keys, and a one-word key, find
  713.  *    the entry with a matching key.  If there is no matching entry,
  714.  *    then create a _new entry that does match.
  715.  *
  716.  * Results:
  717.  *    The return value is a pointer to the matching entry.  If this
  718.  *    is a newly-created entry, then *newPtr will be set to a non-zero
  719.  *    value;  otherwise *newPtr will be set to 0.  If this is a _new
  720.  *    entry the value stored in the entry will initially be 0.
  721.  *
  722.  * Side effects:
  723.  *    A _new entry may be added to the hash table.
  724.  *
  725.  *----------------------------------------------------------------------
  726.  */
  727.  
  728. static Tcl_HashEntry *
  729. ArrayCreate(tablePtr, key, newPtr)
  730.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  731.     register char *key;        /* Key to use to find or create matching
  732.                  * entry. */
  733.     int *newPtr;        /* Store info here telling whether a _new
  734.                  * entry was created. */
  735. {
  736.     register Tcl_HashEntry *hPtr;
  737.     int *arrayPtr = (int *) key;
  738.     register int *iPtr1, *iPtr2;
  739.     int index, count;
  740.  
  741.     for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr;
  742.         count > 0; count--, iPtr1++) {
  743.     index += *iPtr1;
  744.     }
  745.     index = RANDOM_INDEX(tablePtr, index);
  746.  
  747.     /*
  748.      * Search all of the entries in the appropriate bucket.
  749.      */
  750.  
  751.     for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
  752.         hPtr = hPtr->nextPtr) {
  753.     for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words,
  754.         count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
  755.         if (count == 0) {
  756.         *newPtr = 0;
  757.         return hPtr;
  758.         }
  759.         if (*iPtr1 != *iPtr2) {
  760.         break;
  761.         }
  762.     }
  763.     }
  764.  
  765.     /*
  766.      * Entry not found.  Add a _new one to the bucket.
  767.      */
  768.  
  769.     *newPtr = 1;
  770.     hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry)
  771.         + (tablePtr->keyType*sizeof(int)) - 4));
  772.     hPtr->tablePtr = tablePtr;
  773.     hPtr->bucketPtr = &(tablePtr->buckets[index]);
  774.     hPtr->nextPtr = *hPtr->bucketPtr;
  775.     hPtr->clientData = 0;
  776.     for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words, count = tablePtr->keyType;
  777.         count > 0; count--, iPtr1++, iPtr2++) {
  778.     *iPtr2 = *iPtr1;
  779.     }
  780.     *hPtr->bucketPtr = hPtr;
  781.     tablePtr->numEntries++;
  782.  
  783.     /*
  784.      * If the table has exceeded a decent size, rebuild it with many
  785.      * more buckets.
  786.      */
  787.  
  788.     if (tablePtr->numEntries >= tablePtr->rebuildSize) {
  789.     RebuildTable(tablePtr);
  790.     }
  791.     return hPtr;
  792. }
  793.  
  794. /*
  795.  *----------------------------------------------------------------------
  796.  *
  797.  * BogusFind --
  798.  *
  799.  *    This procedure is invoked when an Tcl_FindHashEntry is called
  800.  *    on a table that has been deleted.
  801.  *
  802.  * Results:
  803.  *    If panic returns (which it shouldn't) this procedure returns
  804.  *    NULL.
  805.  *
  806.  * Side effects:
  807.  *    Generates a panic.
  808.  *
  809.  *----------------------------------------------------------------------
  810.  */
  811.  
  812.     /* ARGSUSED */
  813. static Tcl_HashEntry *
  814. BogusFind(tablePtr, key)
  815.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  816.     char *key;            /* Key to use to find matching entry. */
  817. {
  818.     panic("called Tcl_FindHashEntry on deleted table");
  819.     return NULL;
  820. }
  821.  
  822. /*
  823.  *----------------------------------------------------------------------
  824.  *
  825.  * BogusCreate --
  826.  *
  827.  *    This procedure is invoked when an Tcl_CreateHashEntry is called
  828.  *    on a table that has been deleted.
  829.  *
  830.  * Results:
  831.  *    If panic returns (which it shouldn't) this procedure returns
  832.  *    NULL.
  833.  *
  834.  * Side effects:
  835.  *    Generates a panic.
  836.  *
  837.  *----------------------------------------------------------------------
  838.  */
  839.  
  840.     /* ARGSUSED */
  841. static Tcl_HashEntry *
  842. BogusCreate(tablePtr, key, newPtr)
  843.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  844.     char *key;            /* Key to use to find or create matching
  845.                  * entry. */
  846.     int *newPtr;        /* Store info here telling whether a _new
  847.                  * entry was created. */
  848. {
  849.     panic("called Tcl_CreateHashEntry on deleted table");
  850.     return NULL;
  851. }
  852.  
  853. /*
  854.  *----------------------------------------------------------------------
  855.  *
  856.  * RebuildTable --
  857.  *
  858.  *    This procedure is invoked when the ratio of entries to hash
  859.  *    buckets becomes too large.  It creates a _new table with a
  860.  *    larger bucket array and moves all of the entries into the
  861.  *    _new table.
  862.  *
  863.  * Results:
  864.  *    None.
  865.  *
  866.  * Side effects:
  867.  *    Memory gets reallocated and entries get re-hashed to _new
  868.  *    buckets.
  869.  *
  870.  *----------------------------------------------------------------------
  871.  */
  872.  
  873. static void
  874. RebuildTable(tablePtr)
  875.     register Tcl_HashTable *tablePtr;    /* Table to enlarge. */
  876. {
  877.     int oldSize, count, index;
  878.     Tcl_HashEntry **oldBuckets;
  879.     register Tcl_HashEntry **oldChainPtr, **newChainPtr;
  880.     register Tcl_HashEntry *hPtr;
  881.  
  882.     oldSize = tablePtr->numBuckets;
  883.     oldBuckets = tablePtr->buckets;
  884.  
  885.     /*
  886.      * Allocate and initialize the _new bucket array, and set up
  887.      * hashing constants for _new array size.
  888.      */
  889.  
  890.     tablePtr->numBuckets *= 4;
  891.     tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned)
  892.         (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)));
  893.     for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
  894.         count > 0; count--, newChainPtr++) {
  895.     *newChainPtr = NULL;
  896.     }
  897.     tablePtr->rebuildSize *= 4;
  898.     tablePtr->downShift -= 2;
  899.     tablePtr->mask = (tablePtr->mask << 2) + 3;
  900.  
  901.     /*
  902.      * Rehash all of the existing entries into the _new bucket array.
  903.      */
  904.  
  905.     for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
  906.     for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
  907.         *oldChainPtr = hPtr->nextPtr;
  908.         if (tablePtr->keyType == TCL_STRING_KEYS) {
  909.         index = HashString(hPtr->key.string) & tablePtr->mask;
  910.         } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
  911.         index = RANDOM_INDEX(tablePtr, hPtr->key.oneWordValue);
  912.         } else {
  913.         register int *iPtr;
  914.         int count;
  915.  
  916.         for (index = 0, count = tablePtr->keyType,
  917.             iPtr = hPtr->key.words; count > 0; count--, iPtr++) {
  918.             index += *iPtr;
  919.         }
  920.         index = RANDOM_INDEX(tablePtr, index);
  921.         }
  922.         hPtr->bucketPtr = &(tablePtr->buckets[index]);
  923.         hPtr->nextPtr = *hPtr->bucketPtr;
  924.         *hPtr->bucketPtr = hPtr;
  925.     }
  926.     }
  927.  
  928.     /*
  929.      * Free up the old bucket array, if it was dynamically allocated.
  930.      */
  931.  
  932.     if (oldBuckets != tablePtr->staticBuckets) {
  933.     ckfree((char *) oldBuckets);
  934.     }
  935. }
  936.